Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/alexrk/alex.frm

Visual Basic Form | 1995-09-06 | 28.6 KB | 958 lines

VERSION 2.00
Begin Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Alex's Rocket Programmer "
   ClientHeight    =   6330
   ClientLeft      =   120
   ClientTop       =   1635
   ClientWidth     =   9570
   ForeColor       =   &H80000001&
   Height          =   7020
   Icon            =   ALEX.FRX:0000
   Left            =   60
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   6330
   ScaleWidth      =   9570
   Top             =   1005
   Width           =   9690
   Begin TextBox SlopeBox
      Height          =   360
      Left            =   135
      TabIndex        =   28
      Top             =   5920
      Width           =   510
   End
   Begin Frame Frame1
      Caption         =   "Colors"
      Height          =   2295
      Left            =   120
      TabIndex        =   12
      Top             =   3270
      Width           =   1095
      Begin OptionButton White
         Caption         =   "White"
         ForeColor       =   &H00FFFFFF&
         Height          =   380
         Left            =   120
         TabIndex        =   17
         Top             =   1680
         Width           =   855
      End
      Begin OptionButton Black
         Caption         =   "Black"
         ForeColor       =   &H80000007&
         Height          =   380
         Left            =   120
         TabIndex        =   16
         Top             =   1320
         Width           =   855
      End
      Begin OptionButton Red
         Caption         =   "Red"
         ForeColor       =   &H80000001&
         Height          =   380
         Left            =   120
         TabIndex        =   15
         Top             =   960
         Width           =   855
      End
      Begin OptionButton Green
         Caption         =   "Green"
         ForeColor       =   &H80000004&
         Height          =   380
         Left            =   120
         TabIndex        =   14
         Top             =   600
         Width           =   855
      End
      Begin OptionButton Blue
         Caption         =   "Blue"
         Height          =   380
         Left            =   120
         TabIndex        =   13
         Top             =   240
         Value           =   -1  'True
         Width           =   735
      End
   End
   Begin OptionButton Option5
      Caption         =   "50"
      ForeColor       =   &H80000001&
      Height          =   375
      Left            =   225
      TabIndex        =   10
      Top             =   2880
      Value           =   -1  'True
      Width           =   615
   End
   Begin OptionButton Option4
      Caption         =   "40"
      ForeColor       =   &H80000001&
      Height          =   375
      Left            =   240
      TabIndex        =   9
      Top             =   2475
      Width           =   615
   End
   Begin OptionButton Option3
      Caption         =   "30"
      ForeColor       =   &H80000001&
      Height          =   495
      Left            =   240
      TabIndex        =   8
      Top             =   1995
      Width           =   615
   End
   Begin OptionButton Option2
      Caption         =   "20"
      ForeColor       =   &H80000001&
      Height          =   375
      Left            =   240
      TabIndex        =   7
      Top             =   1680
      Width           =   615
   End
   Begin TextBox ProgramBox
      Height          =   4820
      Left            =   7440
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   24
      Top             =   1460
      Width           =   1935
   End
   Begin PictureBox Picture1
      ForeColor       =   &H80000004&
      Height          =   4820
      Left            =   1440
      ScaleHeight     =   4785
      ScaleWidth      =   5985
      TabIndex        =   11
      Top             =   1460
      Width           =   6015
   End
   Begin OptionButton Option1
      Caption         =   "10"
      ForeColor       =   &H80000001&
      Height          =   375
      Left            =   240
      TabIndex        =   6
      Top             =   1275
      Width           =   615
   End
   Begin TextBox TestBox
      Height          =   360
      Left            =   7440
      TabIndex        =   26
      Top             =   1100
      Width           =   1935
   End
   Begin CommandButton Quit
      Caption         =   "Quit"
      Height          =   380
      Left            =   8280
      TabIndex        =   30
      Top             =   600
      Width           =   1215
   End
   Begin CommandButton Run_Program
      Caption         =   "Run Program"
      Height          =   380
      Left            =   6855
      TabIndex        =   19
      Top             =   600
      Width           =   1215
   End
   Begin CommandButton Diag_DnL
      Caption         =   "Diag Dn-L"
      Height          =   380
      Left            =   5520
      TabIndex        =   23
      Top             =   620
      Width           =   1095
   End
   Begin CommandButton Diag_DnR
      Caption         =   "Diag Dn-R"
      Height          =   380
      Left            =   4200
      TabIndex        =   21
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton Down_50
      Caption         =   "&Down"
      Height          =   380
      Left            =   2880
      TabIndex        =   5
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton Up_50
      Caption         =   "&Up"
      Height          =   380
      Left            =   1560
      TabIndex        =   4
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton Clr
      Caption         =   "Clear"
      Height          =   380
      Left            =   240
      TabIndex        =   1
      Top             =   600
      Width           =   1095
   End
   Begin CommandButton ColorFill
      Caption         =   "Color Fill"
      Height          =   380
      Left            =   8280
      TabIndex        =   18
      Top             =   120
      Width           =   1215
   End
   Begin CommandButton Scribble
      Caption         =   "Scribble"
      Height          =   380
      Left            =   6840
      TabIndex        =   25
      Top             =   120
      Width           =   1215
   End
   Begin CommandButton Diag_UpL
      Caption         =   "Diag Up-L"
      Height          =   380
      Left            =   5520
      TabIndex        =   22
      Top             =   120
      Width           =   1095
   End
   Begin CommandButton Diag_UpR
      Caption         =   "Diag Up-R"
      Height          =   380
      Left            =   4200
      TabIndex        =   20
      Top             =   120
      Width           =   1095
   End
   Begin CommandButton Backward_50
      Caption         =   "&Backward"
      Height          =   380
      Left            =   2880
      TabIndex        =   3
      Top             =   120
      Width           =   1095
   End
   Begin CommandButton Forward_50
      Caption         =   "&Forward"
      Height          =   380
      Left            =   1575
      TabIndex        =   2
      Top             =   120
      Width           =   1095
   End
   Begin CommandButton Draw_A_Star
      Caption         =   "Draw a &Star"
      Height          =   380
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   1095
   End
   Begin Label Label2
      Caption         =   "Slope"
      Height          =   300
      Left            =   120
      TabIndex        =   29
      Top             =   5655
      Width           =   1155
   End
   Begin Label Label3
      Caption         =   "Single Line Entry"
      Height          =   300
      Left            =   5535
      TabIndex        =   31
      Top             =   1140
      Width           =   1845
   End
   Begin Label Label1
      Caption         =   "Distance"
      Height          =   255
      Left            =   120
      TabIndex        =   27
      Top             =   1035
      Width           =   1215
   End
   Begin Menu FilePrint
      Caption         =   "File"
      Begin Menu OpenCmdFile
         Caption         =   "Open Command File"
      End
      Begin Menu SaveCmdFile
         Caption         =   "Save Command File"
      End
   End
   Begin Menu DisplayHelp
      Caption         =   "Help (F1)"
      Begin Menu HelpQuickTour
         Caption         =   "Quick Tour"
         Visible         =   0   'False
      End
      Begin Menu HelpCommands
         Caption         =   "Commands"
         Shortcut        =   {F1}
      End
      Begin Menu HelpRegistration
         Caption         =   "Registration"
         Visible         =   0   'False
      End
      Begin Menu HelpAbout
         Caption         =   "About "
         Visible         =   0   'False
      End
   End
Dim Color As String
Dim TextBoxLine As Integer
Dim NL As String
Dim CommandLine As String
Dim CommandWord(0 To 2) As String
' arrays used for testing parsing procedure
Dim aarray(0 To 10)
Dim jarray(0 To 10)
Dim karray(0 To 10)
Dim marray(0 To 10)
Dim narray(0 To 10)
Dim Dis As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim n As Integer
Dim DrawNow As Integer
Dim ScribbleOn As Integer
Dim LC As Integer
Dim LineNumber As Long
Dim CharPos As Long
Dim FileNum As Integer
Dim NametoUse As String
Dim ErrorCode As Integer
Declare Function GetFocus% Lib "user" ()
Declare Function SendMessage% Lib "user" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam As Any)
Sub Backward ()
Old_X = X
Old_Y = Y
Rem ** Move to left **
For I = 0 To Distance Step .5
    Picture1.PSet ((Max((X - I), MinNum)), Y)
    Next
 X = Max((X - I), MinNum)
 Y = Old_Y
End Sub
Sub Backward_50_Click ()
Backward
WriteToProgramBox ("B")
End Sub
Sub Black_Click ()
Form1.Picture1.ForeColor = RGB(0, 0, 0)
Color$ = "Black"
End Sub
Sub Blue_Click ()
Form1.Picture1.ForeColor = RGB(0, 0, 255)
Color$ = "Blue"
End Sub
Sub Clr_Click ()
 Picture1.Cls
 X = DefaultX
 Y = DefaultY
End Sub
Sub ColorFill_Click ()
If BLUE.Value = True Then
Form1.Picture1.BackColor = RGB(0, 0, 255)
ElseIf GREEN.Value = True Then
   Form1.Picture1.BackColor = RGB(0, 255, 0)
ElseIf RED.Value = True Then
   Form1.Picture1.BackColor = RGB(255, 0, 0)
ElseIf Black.Value = True Then
   Form1.Picture1.BackColor = RGB(0, 0, 0)
ElseIf White.Value = True Then
   Form1.Picture1.BackColor = RGB(255, 255, 255)
End If
End Sub
Sub Command2_Click ()
Form1.Cls
End Sub
Sub Diag_DnL_Click ()
DiagDownLeft
WriteToProgramBox ("DDL")
End Sub
Sub Diag_DnR_Click ()
DiagDownRight
WriteToProgramBox ("DDR")
End Sub
Sub Diag_UpL_Click ()
DiagUpLeft
WriteToProgramBox ("DUL")
End Sub
Sub Diag_UpR_Click ()
DiagUpRight
WriteToProgramBox ("DUR")
End Sub
Sub DiagDownLeft ()
Picture1.drawwidth = 3
Old_X = X
Old_Y = Y
Slope = Val(SlopeBox.Text)
Dim EndOfFrameReached As String
' ** upper left to lower right (-x,+y)  **
' ** 2X slope - 1.0 / .5 **
 For I = 0 To Distance Step .2
    Picture1.PSet ((Max((X - (I * (1 / Slope))), MinNum)), (Min((Y + I), MaxNum)))
    'stop loop if end of picture frame is reached
    'min X (far left of frame)
    If Max((X - (I * (1 / Slope))), MinNum) = MinNum Then
       New_Y = Y + I
       New_X = MinNum
       EndOfFrameReached = "TRUE"
    End If
    'max Y (bot of frame)
    If Min((Y + I), MaxNum) = MaxNum Then
       New_X = X - (I * (1 / Slope))
       New_Y = MaxNum
       EndOfFrameReached = "TRUE"
    End If
    ' Can't reset value of I until positions of x and y are
    ' checked, otherwise setting I in first if statement
    ' may cause second if statement to execute also
    If EndOfFrameReached = "TRUE" Then
       I = Distance + 1
       X = New_X
       Y = New_Y
    End If
' reset both points to full distance only if edges of frame not reached
If X <> MinNum And Y <> MaxNum Then
   X = Max((X - (I * (1 / Slope))), MinNum)
   Y = Min((Y + I), MaxNum)
End If
Picture1.drawwidth = 4
End Sub
Sub DiagDownRight ()
Picture1.drawwidth = 3
Old_X = X
Old_Y = Y
Slope = Val(SlopeBox.Text)
Dim EndOfFrameReached As String
' ** upper left to lower right (+x,+y)  **
' ** 2X slope - 1.0 / .5 **
 For I = 0 To Distance Step .2
    Picture1.PSet ((Min((X + (I * (1 / Slope))), MaxNum)), (Min((Y + I), MaxNum)))
    'stop loop if end of picture frame is reached
    'min X (far right of frame)
    If Min((X + (I * (1 / Slope))), MaxNum) = MaxNum Then
       New_Y = Y + I
       New_X = MaxNum
       EndOfFrameReached = "TRUE"
    End If
    'max Y (bot of frame)
    If Min((Y + I), MaxNum) = MaxNum Then
       New_X = X + (I * (1 / Slope))
       New_Y = MaxNum
       EndOfFrameReached = "TRUE"
    End If
    ' Can't reset value of I until positions of x and y are
    ' checked, otherwise setting I in first if statement
    ' may cause second if statement to execute also
    If EndOfFrameReached = "TRUE" Then
       I = Distance + 1
       X = New_X
       Y = New_Y
    End If
' reset both points to full distance only if edges of frame not reached
If X <> MaxNum And Y <> MaxNum Then
   X = Min((X + (I * (1 / Slope))), MaxNum)
   Y = Min((Y + I), MaxNum)
End If
Picture1.drawwidth = 4
End Sub
Sub DiagUpLeft ()
Picture1.drawwidth = 3
Old_X = X
Old_Y = Y
Slope = Val(SlopeBox.Text)
Dim EndOfFrameReached As String
' ** lower left to upper middle (+x,-y)  **
' ** 2X slope - 1.0 / .5 **
 For I = 0 To Distance Step .2
    Picture1.PSet ((Max((X - (I * (1 / Slope))), MinNum)), (Max((Y - I), MinNum)))
    'stop loop if end of picture frame is reached
    'min X (far left of frame)
    If Max((X - (I * (1 / Slope))), MinNum) = MinNum Then
       New_Y = Y - I
       New_X = MinNum
       EndOfFrameReached = "TRUE"
    End If
    'min Y (top of frame)
    If Max((Y - I), MinNum) = MinNum Then
       New_X = X - (I * (1 / Slope))
       New_Y = MinNum
       EndOfFrameReached = "TRUE"
    End If
    ' Can't reset value of I until positions of x and y are
    ' checked, otherwise setting I in first if statement
    ' may cause second if statement to execute also
    If EndOfFrameReached = "TRUE" Then
       I = Distance + 1
       X = New_X
       Y = New_Y
    End If
 Next
' reset both points to full distance only if edges of frame not reached
If X <> MinNum And Y <> MinNum Then
   X = Max((X - (I * (1 / Slope))), MinNum)
   Y = Max((Y - I), MinNum)
End If
Picture1.drawwidth = 4
End Sub
Sub DiagUpRight ()
Picture1.drawwidth = 3
Old_X = X
Old_Y = Y
Slope = Val(SlopeBox.Text)
Dim EndOfFrameReached As String
' add slope to form and here slope 2 = 1/slope = .5
 Rem ** lower left to upper middle (+x,-y)  **
 Rem ** 2X slope - 1.0 / .5 **
 For I = 0 To Distance Step .2
    Picture1.PSet ((Min((X + (I * (1 / Slope))), MaxNum)), (Max((Y - I), MinNum)))
    'stop loop if end of picture frame is reached
    'max X (far right of frame)
    If Min((X + (I * (1 / Slope))), MaxNum) = MaxNum Then
       New_Y = Y - I
       New_X = MaxNum
       EndOfFrameReached = "TRUE"
    End If
    'min Y (top of frame)
    If Max((Y - I), MinNum) = MinNum Then
       New_X = X + (I * (1 / Slope))
       New_Y = MinNum
       EndOfFrameReached = "TRUE"
    End If
    ' Can't reset value of I until both expressions are
    ' checked, otherwise setting I in first if statement
    ' would cause second if statement to execute also
    If EndOfFrameReached = "TRUE" Then
       I = Distance + 1
       X = New_X
       Y = New_Y
    End If
 Next
' reset both points to full distance only if edges of frame not reached
If X <> MaxNum And Y <> MinNum Then
   X = Min((X + (I * (1 / Slope))), MaxNum)
   Y = Max((Y - I), MinNum)
End If
Picture1.drawwidth = 4
End Sub
Sub Down ()
Old_X = X
Old_Y = Y
Rem ** Move down **
For I = 0 To Distance Step 1
    Picture1.PSet (X, (Min((Y + I), MaxNum)))
    Next
 X = Old_X
 Y = Min((Y + I), MaxNum)
End Sub
Sub Down_50_Click ()
WriteToProgramBox ("D")
End Sub
Sub Draw_A_Star_Click ()
    DrawStar
    WriteToProgramBox ("S")
End Sub
Sub DrawStar ()
    Slope = Val(SlopeBox.Text)
    ' ** lower left to upper middle (+x,-y) 120,180 to 140,120  **
    ' ** 3X slope - 1.5 / .5 **
    For I = 0 To Distance Step .2
    Picture1.PSet (X + (I * .5), Y - (1.5 * I))
    Next
    ' ** upper middle to lower right (+x,+y) 140,120 to 160,180  **
    For I = 0 To Distance Step .2
    Picture1.PSet ((X + (Distance * .5)) + (I * .5), (Y - (Distance * 1.5)) + (1.5 * I))
    Next
    ' ** lower right to upper left(-x,-y) 160,180 to 120,140  **
    For I = 0 To Distance Step .2
    Picture1.PSet ((X + Distance) - I, Y - I)
    Next
    ' ** straight across left to right(+x,=y) 120,140 to 160,140  **
    For I = 0 To Distance Step .2
    Picture1.PSet (X + I, (Y - Distance))
    Next
    ' ** upper left to lower right(-x,+y) 160,140 to 120,180  **
    For I = 0 To Distance Step .2
    Picture1.PSet ((X + Distance) - I, (Y - Distance) + I)
    Next
End Sub
Sub Form_Load ()
Picture1.Scale (100, 100)-(200, 200)
Dim I As Integer
Distance = 50
LineColor$ = "Blue"
BLUE.Value = True
Form1.Picture1.ForeColor = RGB(0, 0, 255)
Picture1.drawwidth = 4
Old_X = DefaultX
Old_Y = DefaultY
Option5.Value = True
Slope = 2
SlopeBox.Text = "2"
X = DefaultX
Y = DefaultY
ScribbleOn = False
DrawNow = False
Form1.WindowState = MAXIMIZED
Color = "Blue"
TextBoxLine = 0
NL$ = Chr$(13) + Chr$(10)  ' Defines new line character
End Sub
Sub Form_Unload (Cancel As Integer)
Unload Form1
End Sub
Sub Forward ()
Old_X = X
Old_Y = Y
Rem ** Move to right **
For I = 0 To Distance Step .5
    Picture1.PSet ((Min((X + I), MaxNum)), Y)
    Next
X = Min((X + I), MaxNum)
Y = Old_Y
End Sub
Sub Forward_50_Click ()
Forward
WriteToProgramBox ("F")
End Sub
Function GetLine$ (LineNumber As Long)
  '* This function returns a line of text specified by LineNumber
  '* from the edit control. The first line starts at zero.
   Const MAX_CHAR_PER_LINE = 80
   Const EM_GETLINE = &H400 + 20
   ProgramBox.SetFocus
   Buffer$ = Space$(MAX_CHAR_PER_LINE)
   Pos% = SendMessage(GetFocus(), EM_GETLINE, LineNumber, Buffer$)
   GetLine$ = Buffer$
End Function
Function GetLineCount ()
   Const EM_GETLINECOUNT = &H400 + 10
   ProgramBox.SetFocus
   Pos% = SendMessage(GetFocus(), EM_GETLINECOUNT, 0&, 0&)
   GetLineCount = Pos%
End Function
Function GetSel& ()
  '* This function returns the starting/ending position of the
  '* current selected text.  This is the current location of the
  '* cursor if start is equal to ending.
  '* LOWORD-start position of selected text
  '* HIWORD-first no selected text
   Const EM_GETSEL = &H400 + 0
   ProgramBox.SetFocus
   location& = SendMessage(GetFocus(), EM_GETSEL, 0&, 0&)
   ending% = location& \ 2 ^ 16
   starting% = location& Xor high%
'   aGetSel.Caption = "Caret Location = " + Str$(starting%)
   GetSel = location&
End Function
Sub Green_Click ()
Form1.Picture1.ForeColor = RGB(0, 255, 0)
Color$ = "Green"
End Sub
Sub HelpAbout_Click ()
    HelpTopic$ = "Introduction"
    Form2.Show
End Sub
Sub HelpCommands_Click ()
    HelpTopic$ = "Command"
    Form2.Show
End Sub
Sub HelpQuickTour_Click ()
    HelpTopic$ = "Quick Tour"
    Form2.Show
End Sub
Sub HelpRegistration_Click ()
HelpTopic$ = "Registration"
Form2.Show
End Sub
Function LineFromChar& (CharPos&)
   '* This function will return the line number of the line that
   '* contains the character whose location(index) specified in the
   '* third argument of SendMessage.  If the third argument is -1,
   '* then the number of the line that contains the first character
   '* of the selected text is returned.  Line numbers start at zero.
   Const EM_LINEFROMCHAR = &H400 + 25
   ProgramBox.SetFocus
   Pos% = SendMessage(GetFocus(), EM_LINEFROMCHAR, CharPos&, 0&)
'   aLineFromChar.Caption = "Current Line = " + Str$(Pos%)
   LineFromChar = Pos%
End Function
Function Max (FirstArg, SecondArg)
 If FirstArg > SecondArg Then
 Max = FirstArg
 Else
 Max = SecondArg
 End If
End Function
Function Min (FirstArg, SecondArg)
 If FirstArg < SecondArg Then
 Min = FirstArg
 Else
 Min = SecondArg
 End If
End Function
Sub OpenCloseRoutine (Mode%)
'Open Statement Example
    Dim InputName$
    InputName$ = InputBox$("Enter File Name:", "File Name", NametoUse)
    If InputName$ = " " Then Exit Sub
    NametoUse$ = InputName$
    FileNum% = FreeFile        ' Determine next file number.
    Screen.MousePointer = 11   ' change to hourglass
Select Case Mode
    Case WRITEFILE
    On Error GoTo WriteError
    Open NametoUse$ For Output As FileNum%
    Print #FileNum%, ProgramBox.Text ' Write string to file.
    Close                            ' Close all files.
    MsgBox " File was successful saved - " + NametoUse$, 0
    Case READFILE
    On Error GoTo ReadError
    Open NametoUse For Input As FileNum%
    ProgramBox.Text = Input$(LOF(1), #FileNum%)
    Close
    Case Else
    Exit Sub
End Select
Screen.MousePointer = 0
Exit Sub
WriteError:
    On Error GoTo 0
    MsgBox " Error Writing File " + NametoUse$, 48, "Save File"
    Screen.MousePointer = 0
    Exit Sub
ReadError:
    On Error GoTo 0
    MsgBox " Error Reading File " + NametoUse$, 48, "File Open"
    Screen.MousePointer = 0
    Exit Sub
End Sub
Sub OpenCmdFile_Click ()
OpenCloseRoutine (READFILE)
End Sub
Sub Option1_Click ()
Distance = 10
End Sub
Sub Option2_Click ()
Distance = 20
End Sub
Sub Option3_Click ()
Distance = 30
End Sub
Sub Option4_Click ()
Distance = 40
End Sub
Sub Option5_Click ()
Distance = 50
End Sub
Sub ParseCommandLine (CommandLine As String)
a = 0  ' current position
j = 1  ' start of next word
k = 1  ' position of last comma
n = 0  ' current word in array
' Mid$ syntax (string, from pos, for length)
Do While Len(CommandLine$) > a
    a = a + 1
    ' only parse if current position is a comma and last
    ' position was not a space
    If Mid$(CommandLine$, a, 1) = "," Then
    CommandWord$(n) = Mid$(CommandLine$, j, (a - k))
    CommandWord$(n) = LTrim$(RTrim$(UCase$(CommandWord$(n))))
    j = a + 1
    m = True
    n = n + 1
    End If
' write last command word when end of string is reached
    If Len(CommandLine$) - 1 = a Then
    CommandWord$(n) = Mid$(CommandLine$, j, (a - k))
    CommandWord$(n) = LTrim$(RTrim$(UCase$(CommandWord$(n))))
    End If
    ' k = position of last comma
    If Mid$(CommandLine$, a, 1) = "," Then k = a
End Sub
Sub Picture1_MouseDown (Button As Integer, Shift As Integer, MouseX As Single, MouseY As Single)
If ScribbleOn Then DrawNow = True
Picture1.PSet (MouseX, MouseY)
X = MouseX
Y = MouseY
If ScribbleOn Then GoTo Finish
If TextBoxLine = 0 Then
ProgramBox.Text = "XY" + "," + Str$(MouseX \ 1) + "," + Str$(MouseY \ 1) + " "
ProgramBox.Text = ProgramBox.Text + NL$ + "XY" + "," + Str$(MouseX \ 1) + "," + Str$(MouseY \ 1) + " "
End If
TextBoxLine = TextBoxLine + 1
Finish:
End Sub
Sub Picture1_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
'Ideas - Change Mouse pointer to a paintbrush when scribbleon
'         and positioned within picture box
'        Limit drawing to within picture box - see ClipCursor
'         API call in "Visual Basics #17"
If X > 200 Then X = 199
If X < 100 Then X = 101
If Y > 200 Then Y = 199
If Y < 100 Then Y = 101
If DrawNow Then Picture1.Line -(X, Y)
'X = MouseX
'Y = MouseY
End Sub
Sub Picture1_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawNow = False
End Sub
Sub Quit_Click ()
    Unload Form1
End Sub
Sub Red_Click ()
Form1.Picture1.ForeColor = RGB(255, 0, 0)
Color$ = "Red"
End Sub
Sub Run_Program_Click ()
' The following code performs the following functions:
'     1 - determines the number of lines in the program box
'     2 - Loops through the code and enters a Case
'         statement which sets the proper parameters
'         (color and distance) and executes the proper
'         Control
'This would provide input into the loop which would process
' "commands" in the text box. It returns the number of lines
' in the text2 box.
LC% = GetLineCount() - 1

' GetSel determines the starting and ending
'  position of the selected text
'CharPos& = GetSel()
'LineFromChar uses the character postion returned by GetSel
' to return the line number in the text2 box
'LineNumber& = LineFromChar(CharPos&)
For LineNumber& = 0 To LC%
    ' GetLine returns the text on the line number specified by
    ' the LineNumber variable.
    CommandLine$ = GetLine(LineNumber&)
    RunCommands (CommandLine$)
End Sub
Sub RunCommands (CommandLine As String)
'Parses Commands, right and left trims and converts to upper case
    ParseCommandLine (CommandLine$)
    If CommandWord$(2) = "BLUE" Then Blue_Click
    If CommandWord$(2) = "BLACK" Then Black_Click
    If CommandWord$(2) = "RED" Then Red_Click
    If CommandWord$(2) = "GREEN" Then Green_Click
    If CommandWord$(2) = "WHITE" Then White_Click
    If UCase$(CommandWord$(0)) <> "XY" Then
    Dis = Val(CommandWord$(1))
    If Dis > 99 Then
        MsgBox "Distance cannot be greater than 99. Please re-enter"
        GoTo EndProc
    End If
    End If
    If UCase$(CommandWord$(0)) <> "XY" Then
    Distance = Dis
    End If
    If UCase$(CommandWord$(0)) = "F" Then Forward
    If UCase$(CommandWord$(0)) = "B" Then Backward
    If UCase$(CommandWord$(0)) = "U" Then Up
    If UCase$(CommandWord$(0)) = "D" Then Down
    If UCase$(CommandWord$(0)) = "S" Then DrawStar
    If UCase$(CommandWord$(0)) = "DDR" Then DiagDownRight
    If UCase$(CommandWord$(0)) = "DDL" Then DiagDownLeft
    If UCase$(CommandWord$(0)) = "DUR" Then DiagUpRight
    If UCase$(CommandWord$(0)) = "DUL" Then DiagUpLeft
    If UCase$(CommandWord$(0)) = "XY" Then
       X = Val(CommandWord$(1))
       Y = Val(CommandWord$(2))
       Picture1.PSet (X, Y)
    End If
EndProc:
End Sub
Sub SaveCmdFile_Click ()
OpenCloseRoutine (WRITEFILE)
End Sub
Sub Scribble_Click ()
If ScribbleOn Then
   ScribbleOn = False
   DrawNow = False
   Scribble.Caption = "Scribble Off"
ElseIf ScribbleOn = False Then
   ScribbleOn = True
   Scribble.Caption = "Scribble On"
End If
End Sub
Function SelColor ()
Select Case LineColor$
   Case "Blue"
      SelColor = RGB(0, 0, 255)
   Case "Green"
      SelColor = RGB(0, 255, 0)
   Case "Red"
      SelColor = RGB(255, 0, 0)
   Case "Black"
      SelColor = RGB(0, 0, 0)
   Case "White"
      SelColor = RGB(255, 255, 255)
End Select
End Function
Sub SlopeBox_Change ()
    If Val(SlopeBox.Text) > 99 Then
       MsgBox "Slope cannot be greater than 99. Please re-enter"
       SlopeBox.Text = "2"
    End If
End Sub
Sub TestBox_KeyPress (KeyAscii As Integer)
' Execute Commands in test box when enter is pressed
' A space must be added to end of command line to prevent
' parsing problems
If KeyAscii = 13 Then
    CommandLine$ = TestBox.Text + " "
    RunCommands (CommandLine$)
' Save text box commands to program box
    If TextBoxLine = 0 Then
    ProgramBox.Text = CommandLine$
    Else
    ProgramBox.Text = ProgramBox.Text + NL$ + CommandLine$
    End If
    TextBoxLine = TextBoxLine + 1
End If
End Sub
Sub Up ()
Old_X = X
Old_Y = Y
'** Move Up**
For I = 0 To Distance Step 1
    Picture1.PSet (X, (Max((Y - I), MinNum)))
    Next
 X = Old_X
 Y = Max((Y - I), MinNum)
End Sub
Sub Up_50_Click ()
WriteToProgramBox ("U")
End Sub
Sub White_Click ()
Form1.Picture1.ForeColor = RGB(255, 255, 255)
Color$ = "White"
End Sub
Sub WriteToProgramBox (Action As String)
If TextBoxLine = 0 Then
ProgramBox.Text = Action$ + "," + Str$(Distance) + "," + Color$
ProgramBox.Text = ProgramBox.Text + NL$ + Action$ + "," + Str$(Distance) + "," + Color$
End If
TextBoxLine = TextBoxLine + 1
End Sub